home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbfu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-16  |  6.0 KB  |  183 lines
  1. (*===========================================================================*)
  2. (* File utilities                                                            *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1990, 1991 by H. Roy Engehausen.  All rights reserved.  *)
  5. (*                                                                           *)
  6. (*===========================================================================*)
  7.  
  8. {$O+}
  9.  
  10. UNIT BBFU;
  11.  
  12. INTERFACE
  13.  
  14.   USES
  15.     DOS,
  16.     bbdummy,
  17.     bbmisc5,
  18.     bbsema2,
  19.     bbstr;
  20.  
  21. FUNCTION open_text_file(fileid : file_name_str;
  22.                         direction_in : BOOLEAN) : STRING;
  23.  
  24. FUNCTION close_text_file : STRING;
  25.  
  26. IMPLEMENTATION
  27.  
  28. (*===========================================================================*)
  29. (* Open text file                                                            *)
  30. (*===========================================================================*)
  31.  
  32. FUNCTION open_text_file(fileid : file_name_str;
  33.                         direction_in : BOOLEAN) : STRING;
  34.  
  35.   VAR
  36.     io_code : INTEGER;
  37.  
  38.   BEGIN;
  39.  
  40.     (*-----------------------------------------------------------------------*)
  41.     (* Generate a fileid if necessary                                        *)
  42.     (*-----------------------------------------------------------------------*)
  43.  
  44.     IF fileid = '' THEN
  45.       fileid := opt_block.msg_file_dir + active_tcb^.port_chan_s + '.IN';
  46.  
  47.     (*-----------------------------------------------------------------------*)
  48.     (* Obtain the interrupt semaphore                                        *)
  49.     (*-----------------------------------------------------------------------*)
  50.  
  51.     get_semaphore(semaphore_interrupts, sem_exclusive, FALSE);
  52.  
  53.     WITH active_tcb^ DO
  54.       BEGIN;
  55.  
  56.         (*-------------------------------------------------------------------*)
  57.         (* Close up any left over files.  If there aren't any get a fresh one*)
  58.         (*-------------------------------------------------------------------*)
  59.  
  60.         IF io_fe <> NIL THEN
  61.           BEGIN;
  62.             {$I-}
  63.             CLOSE(io_fe^.fe_text);
  64.             io_code := IORESULT;
  65.             {$I+}
  66.           END
  67.         ELSE
  68.           BEGIN;
  69.             NEW(io_fe);
  70.             FILLCHAR(io_fe^, SIZEOF(io_fe^), CHR(0));
  71.           END;
  72.  
  73.         (*-------------------------------------------------------------------*)
  74.         (* Open the file                                                     *)
  75.         (*-------------------------------------------------------------------*)
  76.  
  77.         WITH io_fe^ DO
  78.           BEGIN;
  79.  
  80.             fe_size := 0;
  81.  
  82.             ASSIGN(fe_text, fileid);
  83.  
  84.             {$I-}
  85.             IF direction_in THEN
  86.               RESET(fe_text)
  87.             ELSE
  88.               REWRITE(fe_text);
  89.             io_code := IORESULT;
  90.             {$I+}
  91.  
  92.           END;
  93.  
  94.         (*-------------------------------------------------------------------*)
  95.         (* Free the interrupt semaphore.                                     *)
  96.         (*-------------------------------------------------------------------*)
  97.  
  98.         free_semaphore(semaphore_interrupts);
  99.  
  100.         (*-------------------------------------------------------------------*)
  101.         (* Generate error message as needed                                  *)
  102.         (*-------------------------------------------------------------------*)
  103.  
  104.         IF io_code = 0 THEN
  105.           open_text_file := ''
  106.         ELSE
  107.           BEGIN;
  108.             open_text_file := dos_err_message(io_code);
  109.             DISPOSE(io_fe);
  110.             io_fe := NIL;
  111.           END;
  112.  
  113.       END;
  114.  
  115.   END;
  116.  
  117. (*===========================================================================*)
  118. (* Close text file                                                           *)
  119. (*===========================================================================*)
  120.  
  121. FUNCTION close_text_file : STRING;
  122.  
  123.   VAR
  124.     io_code : INTEGER;
  125.  
  126.   BEGIN;
  127.  
  128.     WITH active_tcb^ DO
  129.       BEGIN;
  130.  
  131.         (*-------------------------------------------------------------------*)
  132.         (* If nothing here, leave                                            *)
  133.         (*-------------------------------------------------------------------*)
  134.  
  135.         IF io_fe = NIL THEN
  136.           BEGIN;
  137.             close_text_file := '';
  138.             EXIT;
  139.           END;
  140.  
  141.         (*-------------------------------------------------------------------*)
  142.         (* Obtain the interrupt semaphore                                    *)
  143.         (*-------------------------------------------------------------------*)
  144.  
  145.         get_semaphore(semaphore_interrupts, sem_exclusive, FALSE);
  146.  
  147.         (*-------------------------------------------------------------------*)
  148.         (* Close up the file (if any)                                        *)
  149.         (*-------------------------------------------------------------------*)
  150.  
  151.         {$I-}
  152.         CLOSE(io_fe^.fe_text);
  153.         io_code := IORESULT;
  154.         {$I+}
  155.  
  156.         (*-------------------------------------------------------------------*)
  157.         (* Free space                                                        *)
  158.         (*-------------------------------------------------------------------*)
  159.  
  160.         DISPOSE(io_fe);
  161.         io_fe := NIL;
  162.  
  163.       END;
  164.  
  165.     (*-----------------------------------------------------------------------*)
  166.     (* Free the interrupt semaphore.                                         *)
  167.     (*-----------------------------------------------------------------------*)
  168.  
  169.     free_semaphore(semaphore_interrupts);
  170.  
  171.     (*-----------------------------------------------------------------------*)
  172.     (* Generate error message as needed                                      *)
  173.     (*-----------------------------------------------------------------------*)
  174.  
  175.     IF io_code = 0 THEN
  176.       close_text_file := ''
  177.     ELSE
  178.       close_text_file := dos_err_message(io_code);
  179.  
  180.   END;
  181.  
  182. END.
  183.